      subroutine correcte0 
!-----------------------------------------------
!   M o d u l e s 
!-----------------------------------------------
      USE vast_kind_param, ONLY:  double 
      use corgan_com_M 
      use cindex_com_M 
      use numpar_com_M 
      use cprplt_com_M, ONLY:  
      use cophys_com_M 
      use ctemp_com_M, ONLY: fmf, fef, fvf, fbxf, fbyf, fbzf, twx 
      use blcom_com_M, ONLY: qom, wate, qdnv, qdnc0, bxv, byv, bzv, gradxb, &
         gradyb, gradzb, a11, itmax, itsub, phipot, ex0, ey0, ez0, chnorm1, &
         chnorm2, vol, vvol, ijkcell, ijkvtx, c1x, c2x, c3x, c4x, c5x, c6x, &
         c7x, c8x, c1y, c2y, c3y, c4y, c5y, c6y, c7y, c8y, c1z, c2z, c3z, c4z, &
         c5z, c6z, c7z, c8z, wkl, wkr, wke, wkf, periodicx, nsmooth 
      use objects_com_M, ONLY:  
!...Translated by Pacific-Sierra Research 77to90  4.3E  14:13:36   8/20/02  
!...Switches: -yf -x1             
!
      implicit none
!-----------------------------------------------
!   G l o b a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   P a r a m e t e r s
!-----------------------------------------------
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      integer , dimension(8) :: iv 
      integer , dimension(4) :: lioinput, lioprint 
      integer :: n, iter 
      real(double), dimension(1) :: ixi1, ixi2, ieta1, ieta2 
      real(double) :: ixi4, ieta4, ixi5, ieta5 
      real(double), dimension(8) :: wght 
      real(double), dimension(100) :: fpxf, fpyf, fpzf, fpxft, fpyft, fpzft, &
         ucm, vcm, wcm, cm 
      real(double), dimension(3,20) :: wsin, wcos 
      real(double), dimension(3,12,20) :: tsi, rot 
      real(double) :: dummy, error, transpos, tiny 
      logical :: expnd, nomore 
      character :: name*80 
!-----------------------------------------------
!
!     a routine to reset e0 and check charge conservation
!
      write (*, *) 'CORRECT E0' 
!
!     test charge conservation
!
      call divc (ncells, ijkcell, iwid, jwid, kwid, c1x, c2x, c3x, c4x, c5x, &
         c6x, c7x, c8x, c1y, c2y, c3y, c4y, c5y, c6y, c7y, c8y, c1z, c2z, c3z, &
         c4z, c5z, c6z, c7z, c8z, vol, ex0, ey0, ez0, a11) 
!
      chnorm1 = 0.0 
      chnorm2 = 0.0 
      do n = 1, ncells 
         ijk = ijkcell(n) 
         chnorm1 = chnorm1 + (a11(ijk)-fourpi*qdnc0(ijk))**2 
         chnorm2 = max(chnorm2,abs(a11(ijk)-fourpi*qdnc0(ijk))) 
      end do 
      chnorm1 = sqrt(chnorm1/ncells) 
      write (*, *) 'test charge conserv: norm2,maxnorm', chnorm1, chnorm2 
!
!     if the following line is not commented out, it does no
!     correction of the electric field
!
!     return
!
!     correct e0
!
      dummy = 0. 
      error = 1.E-3 
!
      call newerpois (ncells, ijkcell, nvtx, ijkvtx, itdim, nrg, iwid, jwid, &
         kwid, precon, transpos, tiny, ibp1, jbp1, kbp1, c1x, c2x, c3x, c4x, &
         c5x, c6x, c7x, c8x, c1y, c2y, c3y, c4y, c5y, c6y, c7y, c8y, c1z, c2z, &
         c3z, c4z, c5z, c6z, c7z, c8z, vol, vvol, wate(1,29), itsub, itmax, &
         error, fourpi, dummy, cntr, clite, wkl, wkr, wkf, wke, periodicx, &
         qdnc0, qdnv, qom, bxv, byv, bzv, wate(1,26), wate(1,27), wate(1,28), &
         ex0, ey0, ez0, wate(1,25), wate(1,24), wate(1,23), wate(1,1), gradxb, &
         gradyb, gradzb, phipot, wate(1,22), 0., nsmooth, iter) 
!
      call bcperv (ibp1 + 1, jbp1 + 1, kbp1 + 1, iwid, jwid, kwid, sdlt, cdlt, &
         ex0, ey0, ez0, periodicx) 
!
      return  
      end subroutine correcte0 
